perm filename FILLZ.F4[1,LCS] blob sn#093917 filedate 1974-03-25 generic text, type T, neo UTF8
00100		IMPLICIT INTEGER(A-Z)
00200		COMMON D(2000),Q(100),R(100),E(100),NN
00300		DATA Q/24,50,0,24,24,42,8,24,24,32,16,24,88*0/
00400		1,R/30,0,0,30,24,4,4,24,16,8,8,16,88*0/
00450		1,E/-1,0,0,0,-1,0,0,0,-1,91*0/,TOT/12/
00500	
00600		NN=0
01410	15	TYPE 151
01420	151	FORMAT(' TYPE COORDS.'/)
01430	152	FORMAT(60I)
01440		ACCEPT 152,(Q(K),K=1,60)
01450		ACCEPT 152,(R(K),K=1,60)
01625		ACCEPT 152,(E(K),K=1,60)
01635		ACCEPT 152,TOT
01640	400	DO 40 K=1,TOT
01650		J=2
01660		IF(E(K))J=3
01670	40	CALL LINES(Q(K),R(K),J)
01700		N=1
01800	4	JJ=0
01900		H=-1000
01950		Z=0
02000		DO 1 K=2,TOT
02100		IF(E(K).NE.0)GO TO 1
02150		A=R(K)
02160		B=R(K-1)
02165		IF(B.GT.A)GO TO 21
02170		C=A*1000+B
02175		GO TO 20
02180	21	C=B*1000+A
02190	20	IF(C.LE.Z)GO TO 1
02195		Z=C
02200	C  FINDS HIGHEST LINE
02300		JJ=K
02400		H=R(JJ)
02500	1	CONTINUE
02600	
02700		IF(JJ.EQ.0)GO TO 10
02800		J=JJ
02900		JA=J-1
03600	C  J = END OF HIGHEST LINE
03700	19	RT=Q(J)
03800		LF=Q(JA)
04000		RJ=R(J)
04100		RJ1=R(JA)
04200	16	E(J)=-1
04300	C  LINE USED
04400		HT=RJ-RJ1
04700		U=LF
04800		IF(RT.GT.U)GO TO 170
04810		LF=RT
04820		RT=U
04850	170	IF(RJ1.LT.RJ)RJ=RJ1
04860		DIS=RT-LF
04900	
05000	17	DO 2 K=LF,RT
05100		D(N)=K
05200		Y=(HT*(K-U))/DIS+RJ
05300		D(N+1)=Y
05400		H=-1000
05500	
05600	18	DO 3 I=2,TOT
05610		IF(E(I))GO TO 3
05655	C  SKIP IF SAME LINE.
06100		QA=Q(I)
06200		QB=Q(I-1)
06300		IF((QA.GT.K.AND.QB.GT.K).OR.(QA.LT.K.AND.QB.LT.K))GOTO 3
06400	C  LINE WAS NOT UNDER POINT K
06410		RA=R(I)
06420		RB=R(I-1)
06500		HX=RA-RB
06560		DX=IABS(QA-QB)
06575		IF(QA.GT.QB)QA=QB
06600		IF(RA.LT.RB)RA=RB
06900		B=(HX*(K-QA))/DX+RA
07210		IF(B.GT.Y)GO TO 3
07300		IF(B.LE.H)GO TO 3
07400		H=B
07500		IX=I
07600	C  FOUND HIGHEST NEW POINT
07700	3	CONTINUE
07710		IF(H.EQ.Y)GO TO 2
08000	C  WIPES OUT THIS LINE SEG.
08200	30	IF(K.NE.Q(IX).AND.K.NE.Q(IX-1))E(IX)=1
08250	C  TOUCHING END OF SEG. DOES NOT COUNT.
08300	
08310		IF(H.EQ.-1000)GO TO 2
08400	31	D(N+2)=H
08500		N=N+3
08600	2	CONTINUE
08700	
08750		IF(D(N).EQ.-1000)GO TO 4
08800		D(N)=-1000
08900	C  MARKS END OF ONE FILL SECTION
09000		N=N+1
09100		GO TO 4
09200	
09350	10	N=N-1
09400		D(N)=-9999
09500	C  MARKS FINAL END
09510		IO=5
09520	33	WRITE(IO,34)(D(K),K=1,N)
09530	34	FORMAT(9I6)
09600		N=1
09700	13	J=3
09800	C  FOR INVIS. VECT.
09900		DX=D(N)
10000	12	CALL LINES(DX,D(N+1),J)
10100		J=2
10200		CALL LINES(DX,D(N+2),J)
10300		N=N+3
10400		DX=D(N)
10500		IF(DX.LE.-1000)GO TO 11
10600		CALL LINES(DX,D(N+2),J)
10700		CALL LINES(DX,D(N+1),J)
10800		N=N+3
10900		DX=D(N)
11000		IF(DX.GT.-1000)GO TO 12
11100	
11200	11	IF(DX.EQ.-9999)GO TO 14
11300		N=N+1
11400		GO TO 13
11500	14	PAUSE
11600		GO TO 15
11700		END
11800	
11900